home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / zgeru.f < prev    next >
Text File  |  1996-07-19  |  4KB  |  158 lines
  1.       SUBROUTINE ZGERU ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
  2. *     .. Scalar Arguments ..
  3.       COMPLEX*16         ALPHA
  4.       INTEGER            INCX, INCY, LDA, M, N
  5. *     .. Array Arguments ..
  6.       COMPLEX*16         A( LDA, * ), X( * ), Y( * )
  7. *     ..
  8. *
  9. *  Purpose
  10. *  =======
  11. *
  12. *  ZGERU  performs the rank 1 operation
  13. *
  14. *     A := alpha*x*y' + A,
  15. *
  16. *  where alpha is a scalar, x is an m element vector, y is an n element
  17. *  vector and A is an m by n matrix.
  18. *
  19. *  Parameters
  20. *  ==========
  21. *
  22. *  M      - INTEGER.
  23. *           On entry, M specifies the number of rows of the matrix A.
  24. *           M must be at least zero.
  25. *           Unchanged on exit.
  26. *
  27. *  N      - INTEGER.
  28. *           On entry, N specifies the number of columns of the matrix A.
  29. *           N must be at least zero.
  30. *           Unchanged on exit.
  31. *
  32. *  ALPHA  - COMPLEX*16      .
  33. *           On entry, ALPHA specifies the scalar alpha.
  34. *           Unchanged on exit.
  35. *
  36. *  X      - COMPLEX*16       array of dimension at least
  37. *           ( 1 + ( m - 1 )*abs( INCX ) ).
  38. *           Before entry, the incremented array X must contain the m
  39. *           element vector x.
  40. *           Unchanged on exit.
  41. *
  42. *  INCX   - INTEGER.
  43. *           On entry, INCX specifies the increment for the elements of
  44. *           X. INCX must not be zero.
  45. *           Unchanged on exit.
  46. *
  47. *  Y      - COMPLEX*16       array of dimension at least
  48. *           ( 1 + ( n - 1 )*abs( INCY ) ).
  49. *           Before entry, the incremented array Y must contain the n
  50. *           element vector y.
  51. *           Unchanged on exit.
  52. *
  53. *  INCY   - INTEGER.
  54. *           On entry, INCY specifies the increment for the elements of
  55. *           Y. INCY must not be zero.
  56. *           Unchanged on exit.
  57. *
  58. *  A      - COMPLEX*16       array of DIMENSION ( LDA, n ).
  59. *           Before entry, the leading m by n part of the array A must
  60. *           contain the matrix of coefficients. On exit, A is
  61. *           overwritten by the updated matrix.
  62. *
  63. *  LDA    - INTEGER.
  64. *           On entry, LDA specifies the first dimension of A as declared
  65. *           in the calling (sub) program. LDA must be at least
  66. *           max( 1, m ).
  67. *           Unchanged on exit.
  68. *
  69. *
  70. *  Level 2 Blas routine.
  71. *
  72. *  -- Written on 22-October-1986.
  73. *     Jack Dongarra, Argonne National Lab.
  74. *     Jeremy Du Croz, Nag Central Office.
  75. *     Sven Hammarling, Nag Central Office.
  76. *     Richard Hanson, Sandia National Labs.
  77. *
  78. *
  79. *     .. Parameters ..
  80.       COMPLEX*16         ZERO
  81.       PARAMETER        ( ZERO = ( 0.0D+0, 0.0D+0 ) )
  82. *     .. Local Scalars ..
  83.       COMPLEX*16         TEMP
  84.       INTEGER            I, INFO, IX, J, JY, KX
  85. *     .. External Subroutines ..
  86.       EXTERNAL           XERBLA
  87. *     .. Intrinsic Functions ..
  88.       INTRINSIC          MAX
  89. *     ..
  90. *     .. Executable Statements ..
  91. *
  92. *     Test the input parameters.
  93. *
  94.       INFO = 0
  95.       IF     ( M.LT.0 )THEN
  96.          INFO = 1
  97.       ELSE IF( N.LT.0 )THEN
  98.          INFO = 2
  99.       ELSE IF( INCX.EQ.0 )THEN
  100.          INFO = 5
  101.       ELSE IF( INCY.EQ.0 )THEN
  102.          INFO = 7
  103.       ELSE IF( LDA.LT.MAX( 1, M ) )THEN
  104.          INFO = 9
  105.       END IF
  106.       IF( INFO.NE.0 )THEN
  107.          CALL XERBLA( 'ZGERU ', INFO )
  108.          RETURN
  109.       END IF
  110. *
  111. *     Quick return if possible.
  112. *
  113.       IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
  114.      $   RETURN
  115. *
  116. *     Start the operations. In this version the elements of A are
  117. *     accessed sequentially with one pass through A.
  118. *
  119.       IF( INCY.GT.0 )THEN
  120.          JY = 1
  121.       ELSE
  122.          JY = 1 - ( N - 1 )*INCY
  123.       END IF
  124.       IF( INCX.EQ.1 )THEN
  125.          DO 20, J = 1, N
  126.             IF( Y( JY ).NE.ZERO )THEN
  127.                TEMP = ALPHA*Y( JY )
  128.                DO 10, I = 1, M
  129.                   A( I, J ) = A( I, J ) + X( I )*TEMP
  130.    10          CONTINUE
  131.             END IF
  132.             JY = JY + INCY
  133.    20    CONTINUE
  134.       ELSE
  135.          IF( INCX.GT.0 )THEN
  136.             KX = 1
  137.          ELSE
  138.             KX = 1 - ( M - 1 )*INCX
  139.          END IF
  140.          DO 40, J = 1, N
  141.             IF( Y( JY ).NE.ZERO )THEN
  142.                TEMP = ALPHA*Y( JY )
  143.                IX   = KX
  144.                DO 30, I = 1, M
  145.                   A( I, J ) = A( I, J ) + X( IX )*TEMP
  146.                   IX        = IX        + INCX
  147.    30          CONTINUE
  148.             END IF
  149.             JY = JY + INCY
  150.    40    CONTINUE
  151.       END IF
  152. *
  153.       RETURN
  154. *
  155. *     End of ZGERU .
  156. *
  157.       END
  158.